# read in low test expect data exported from gorilla
setwd(here::here('SF_data', 'Gorilla_data_low'))
data=here::here('SF_data', 'Gorilla_data_low') # path to data files
file_list=list.files(data, pattern=".csv") # list of data files
# read in all files
datasetlow <-
do.call("rbind", lapply(file_list, FUN=function(files){
for (i in 1:length(files)){
if(file.exists(files[i])){
message( "now processing:", files[i])
}
}
fread(files, header=TRUE, sep=",", na.strings = "", fill=TRUE)})) #fread makes reading in files quick
#
library(lubridate)
# clean up data! Select data from after the pre-registation!
low<-datasetlow %>%
janitor::clean_names(.) %>%
dplyr::mutate(date=as.Date(utc_date)) %>%
dplyr::filter(date=="08/06/2020" |date=="09/06/2020" , zone_type=="response_button_text")
#response as character
low$response<-as.character(low$response)
#assign column to denot low test expect
low$testexpect<-"low"
# high test expect
setwd(here::here('SF_data', 'Gorilla_data_high'))
data=here::here('SF_data', 'Gorilla_data_high') # path to data files
file_list=list.files(data, pattern=".csv") # list of data files
# read in all files
highdata <-
do.call("rbind", lapply(file_list, FUN=function(files){
for (i in 1:length(files)){
if(file.exists(files[i])){
message( "now processing:", files[i])
}
}
fread(files, header=TRUE, sep=",", na.strings = "", fill=TRUE)})) #fread makes reading in files quick
#
library(lubridate)
# a batch of Ss we run before preregistration that should not be included in the analysis
high <-highdata %>%
janitor::clean_names(.) %>%
dplyr::mutate(date=as.Date(utc_date)) %>%
dplyr::filter(date=="08/06/2020" | date=="0009/07/2020" |date=="0010/07/2020" | date=="09/06/2020", zone_type=="response_button_text")
#response as character
high$response<-as.character(high$response)
# assign column to denot high test expect
high$testexpect<-"high"
# bind low and high datasets
high_low<-rbind(high, low)
#response as character
#calculate hit rate and far and compute dprime and other measures
ex4=high_low %>% dplyr::mutate(condition1= dplyr::case_when(
condition == "SF" ~ "Sans Forgetica",
condition =="normal" ~ "Arial",
), isold= dplyr::case_when (
old_new== "old" ~ 1,
old_new== "new" ~ 0),
sayold=dplyr::case_when(
response=="old"~ 1,
response=="new" ~ 0,
))
#classic SDT
sdt <- ex4 %>%
dplyr::mutate(type = "hit",
type = ifelse(isold==1 & sayold==0, "miss", type),
type = ifelse(isold==0 & sayold==0, "cr", type), # Correct rejection
type = ifelse(isold==0 & sayold==1, "fa", type)) # False alarm
sdt <- sdt %>%
dplyr::group_by(participant_private_id, type, condition1, testexpect) %>%
dplyr::summarise(count = n()) %>%
tidyr::spread(type, count) # Format data to one row per person
sdt <- sdt %>%
dplyr::group_by(participant_private_id, condition1, testexpect)%>%
dplyr::mutate(hr = hit / (hit+miss),
fa = fa / (fa+cr)) %>%
dplyr::mutate(hr=case_when(
is.na(hr) ~ 0.99,
TRUE ~ hr),
fa=case_when(
is.na(fa) ~ 0.01,
TRUE ~ fa),
zhr=qnorm(hr),
zfa=qnorm(fa),
dprime = zhr-zfa) %>%
ungroup()
Raincloud plots (Allen et al., 2019) depicting raw data (dots), box plots, and half violin kernel desntiy plots, with mean (red dot). Proportion of “old” responses as a function of Test Expectancy for Experiment 1.
#set up raincloud params
# fig for dprime
highlowaov=sdt %>% select(participant_private_id, condition1, testexpect, dprime) %>%
mutate(testexpect=ifelse(testexpect=="low", "Low Test Expectancy", "High Test Expectancy"))
#plot
fig1 <- ggplot(highlowaov,aes(x=condition1,y=dprime,fill=condition1))+ facet_grid(~testexpect) +
geom_flat_violin(position = position_nudge(x = .2, y = 0), alpha = .4,adjust=4)+
geom_point(position=position_jitter(width = .15),size = 1, alpha = 0.2) +
geom_boxplot(aes(x = condition1, y = dprime),outlier.shape = NA,
alpha = 0.3, width = .1, colour = "BLACK") +
stat_summary(fun=mean, geom="point", colour="darkred", size=3) +
theme_cowplot() +
scale_colour_brewer(palette = "Dark2")+
scale_fill_brewer(palette = "Dark2") +
labs(y = "Sensitivity(d')", x = "Typeface") + theme(legend.position = "none")
fig1
ggsave("dprimefig1.png", width=8, height=4)
#ANOVA
a1 <- aov_ez("participant_private_id", "dprime", highlowaov,
between = c("testexpect"), within=c("condition1")) # mixed
summary(a1)
##
## Univariate Type III Repeated-Measures ANOVA Assuming Sphericity
##
## Sum Sq num Df Error SS den Df F value Pr(>F)
## (Intercept) 296.652 1 166.184 229 408.7834 < 2.2e-16 ***
## testexpect 2.980 1 166.184 229 4.1058 0.043896 *
## condition1 1.818 1 38.786 229 10.7344 0.001215 **
## testexpect:condition1 0.735 1 38.786 229 4.3369 0.038405 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
#kable(summary(a1))
# get JOls from raw data
high
jol_high<- highdata %>%
mutate(testexpect="high")
low